home *** CD-ROM | disk | FTP | other *** search
/ PC-SIG: World of Games / PC-SIG World of Games (CDRM1080710) (1993).iso / ENT / DISK1133.ZIP / WORLDGEN.ZIP / WG4.INC < prev    next >
Text File  |  1989-08-29  |  17KB  |  420 lines
  1. Procedure Choose_New_Sun(Position_In_System: Integer);
  2. {part of magrathea, below}
  3. Begin;
  4.   Clearscreen;
  5.   GotoXY(6,6);
  6.   Writeln('Press keys to select star type'#10#13'as follows [most stars are in');
  7.   Writeln('the astronomical main sequence;'#10#13'see documentation for details.]');
  8.   TextColor(1);
  9.   Writeln('Star type B0 B5 A0 A5 F0 F5 G0'#10#13'Key        A  B  C  D  E  F  G');
  10.   Writeln;
  11.   Writeln('Star type G5 K0 K5 M0 M5 M9 DG'#10#13'Key        H  I  J  K  L  M  N');
  12.   Writeln;
  13.   If Position_In_System = 0 then begin;
  14.     Writeln('or "O" for a binary pair'#10#13'   "P" for a black hole'#10#13'   "Q" for a proto-star');
  15.     Writeln;
  16.     TextColor(2);
  17.     Writeln('Editing primary does not change'#10#13'other planets and stars: they'#10#13'should be edited to suit the');
  18.     Writeln('new sun!');
  19.   End
  20.   else begin;
  21.     TextColor(2);
  22.     Writeln('Try to avoid a secondary star'#10#13'that`s larger than the primary.'#10#13'Oxygen worlds aren`t likely in');
  23.     Writeln('any form of multi-star system!');
  24.   End;
  25.   Repeat;
  26.      Beep_Wait;
  27.       Case Dummy of
  28.       'A'..'N': Begin;
  29.                   V := Ord(dummy) - Ord('A');
  30.                   Star_Type := Star_Name_Tags[V];
  31.                   V := 1;
  32.                 End;
  33.            'O': If Position_In_System = 0 then Begin; Star_Type := '*' + Chr(Random(40)+10); V := 1; End;
  34.            'P': If Position_In_System = 0 then Begin; Star_Type := '( '; V := 1; End;
  35.            'Q': If Position_In_System = 0 then Begin; Star_Type := ') '; V := 1; End;
  36.       end;
  37.     Until V = 1;
  38. End;
  39.  
  40. Procedure Replace_Planet;
  41. Begin;
  42.    V:= 1;
  43.    Delete (System_Details [Y_Coordinate, X_Coordinate],(2*Planet_Number) + 4, 1);
  44.    Insert (Dummy, System_Details [Y_Coordinate, X_Coordinate],(2*Planet_Number) + 4);
  45. End;
  46.  
  47. Procedure Magrathea;
  48. {edit and build solar systems}
  49. Begin;
  50.   If Systems_In_Memory = 0 then
  51.      Begin;
  52.        No_Sector_Error;
  53.        Exit;
  54.      End;
  55.   Choose_System(2);
  56.   If Menu_Status = 0 then exit else
  57.       Begin;
  58.         Colour_Selection;
  59.         WG_System := System_Details [Y_Coordinate, X_Coordinate];
  60.         Protected_System := WG_System;
  61.         Clearscreen;
  62.         If System_Details [Y_Coordinate, X_Coordinate] <= '!' then
  63.              Begin;
  64.                 Str (Y_Coordinate, A);
  65.                 Str (X_Coordinate, B);
  66.                 Str (Random(10), C); {choose a random Z-coordinate}
  67.                 System_Location := A + B + C;
  68.                 System_Details [Y_Coordinate, X_Coordinate] := System_Location;
  69.                 Old_Systems; {call to a badly-named routine}
  70.                 New_System_Map; {it's easier to edit something that's there}
  71.              end;
  72.       End;
  73.     Repeat;
  74.       Colour_Selection;
  75.       Edit_Status := 9;
  76.       If System_Details [Y_Coordinate, X_Coordinate] <= '!' then
  77.         System_Window
  78.          else Begin;
  79.            Old_Systems;
  80.            Old_System_Map;
  81.          end;
  82.       For I := 0 to 9 do Numbers((I*17)+5,3,I,3);
  83.       For I := 10 to 17 do begin;
  84.          Numbers((I*17)+5,3,1,3);
  85.          Numbers((I*17)+10,3,I-10,3);
  86.       end;
  87.       GraphWindow(0,33,319,199);
  88.       GotoXY(6,6);
  89.       TextColor(2);
  90.       Security_Tag := Copy(WG_System,40,1);
  91.       Writeln('Press keys to choose options'#10#10#13'[P] Edit PRIMARY star'#10#13'[O] Change ORBITING planet / star');
  92.       Writeln('[Z] Change Z-COORDINATE'#10#13#10#13'[D] DELETE system'#10#13'[G] GENERATE a new system here');
  93.       Write('[S] Change SECURITY to ');
  94.       If Security_Tag = '*' then writeln ('clear') else Writeln ('RESTRICTED');
  95.       Writeln(#10#13'[M] Look at detailed MAPS');
  96.       Writeln(#10#13'[C] CANCEL all changes'#10#13'[X] eXit [accept changes]'#10#10#13'[H] HELP');
  97.       Beep_Wait;
  98.       Case dummy of
  99.       'P': Edit_Status := 0;
  100.       'O': Edit_Status := 1;
  101.       'Z': Edit_Status := 2;
  102.       'D': Edit_Status := 3;
  103.       'G': Edit_Status := 4;
  104.       'M': Edit_Status := 5;
  105.       'C': Edit_Status := 6;
  106.       'X': Edit_Status := 7;
  107.       'S': Edit_Status := 8;
  108.       'H': Edit_status := 9;
  109.       end;
  110.  
  111.       If Edit_Status = 0 then begin;
  112.       V := 0;
  113.       Choose_New_Sun(0);
  114.       Delete (System_Details [Y_Coordinate, X_Coordinate],4,2);
  115.       Insert (Star_Type, System_Details [Y_Coordinate, X_Coordinate],4);
  116.       End;
  117.  
  118.       If Edit_Status = 1 then begin;
  119.         Planet_Number := -1;
  120.         ClearScreen;
  121.         GotoXY(6,6);
  122.         Writeln('Press planet number, 1 to 9'#10#13'or A to H for planets 10 to 17');
  123.         Repeat;
  124.           Beep_wait;
  125.           If Dummy >='A' then if Dummy <= 'H' then
  126.             Planet_Number := Ord(Dummy) - Ord('A') + 10;
  127.           If Dummy >='0' then if Dummy <= '9' then
  128.             Val (Dummy,Planet_Number,N);
  129.         Until Planet_Number <> -1;
  130.         ClearScreen;
  131.         GotoXY(6,6);
  132.         Writeln('Planet/Star ',Planet_Number,' selected');
  133.         Writeln('Press for replacement:'#10#13'<Space bar> = nothing'#10#13'   0 = Asteroids');
  134.         Writeln('   1 = Earth-like'#10#13'   2 = Poison atmosphere'#10#13'   3 = Airless, cratered');
  135.         Writeln('   4 = Airless, mountainous'#10#13'   5 = Airless, icy'#10#13' 6-7 = Gas giant [no rings]:');
  136.         Writeln(' 8-9 = Ringed gas giant:'#10#13' [7 & 9 are bigger than 6 & 8]'#10#13'   A = Companion star:');
  137.         Writeln('   Q = Ringworld (poison)'#10#13'   R = Ringworld (oxygen)'#10#13'   S = Dust cloud');
  138.         V := 0;
  139.         Repeat
  140.            Beep_Wait;
  141.            Case Dummy of
  142.            '0'..'9': Replace_Planet;
  143.                 ' ': Replace_Planet;
  144.                 'A': Begin;
  145.                       Choose_New_Sun(1);
  146.                       Delete (System_Details [Y_Coordinate, X_Coordinate],(2*Planet_Number) + 4, 2);
  147.                       Insert (Star_Type, System_Details [Y_Coordinate, X_Coordinate],(2*Planet_Number) + 4);
  148.                      End;
  149.            'Q'..'S': Replace_Planet;
  150.            End;
  151.         Until V = 1;
  152.       End;
  153.  
  154.       If Edit_Status = 2 then begin;
  155.           ClearScreen;
  156.           GotoXY(6,6);
  157.           Writeln('Enter new Z-Coordinate, 0 to 9');
  158.           Repeat Beep_Wait until (Dummy >='0') and (Dummy <='9');
  159.           Delete (System_Details [Y_Coordinate, X_Coordinate],3,1);
  160.           Insert (Dummy, System_Details [Y_Coordinate, X_Coordinate],3);
  161.       End;
  162.  
  163.       If Edit_Status = 3 then begin;
  164.           ClearScreen;
  165.           GotoXY(6,6);
  166.           Writeln('Delete System: Are you sure (Y/N)'#10#13'If you do this, only options'#10#13'[G] GENERATE a new system,');
  167.           Writeln('[L] LOSE all changes, or'#10#13'[X] eXit     will work!!');
  168.           Beep_Wait;
  169.           If Dummy = 'Y' then System_Details[Y_Coordinate,X_Coordinate] := '   ';
  170.       End;
  171.  
  172.       If Edit_Status = 4 then begin;
  173.          ClearScreen;
  174.          GotoXY(6,6);
  175.          Writeln('Generate a random system?'#10#13'Are you sure (Y/N)??'#10#13'You will lose all edits!!');
  176.          Beep_Wait;
  177.           If Dummy = 'Y' then begin;
  178.              Str (Y_Coordinate, A);
  179.              Str (X_Coordinate, B);
  180.              Str (Random(10), C); {choose a random Z-coordinate}
  181.              System_Location := A + B + C;
  182.              System_Details [Y_Coordinate, X_Coordinate] := System_Location;
  183.              Old_Systems; {call to a badly-named routine}
  184.              New_System_Map;
  185.           end;
  186.       end;
  187.  
  188.       If Edit_Status = 5 then Planet_Details(1);
  189.  
  190.       If Edit_Status = 6 then
  191.           System_Details [Y_Coordinate,X_Coordinate] := Protected_System;
  192.  
  193.       If Edit_Status = 8 then begin;
  194.           Delete (System_Details [Y_Coordinate, X_Coordinate],40,1);
  195.           If Security_Tag <> '*' then Security_Tag := '*' else Security_Tag := ' ';
  196.           Insert (Security_Tag, System_Details [Y_Coordinate, X_Coordinate],40);
  197.         end;
  198.  
  199.       If edit_Status = 9 then Help('EDIT',' POZDGSMCX');
  200.  
  201.   Until Edit_Status = 7;
  202.   Make_Mini_Map;
  203. End;
  204. {-------------------------------------------------------------------------}
  205. {                         STATISTICAL ROUTINES                            }
  206. {-------------------------------------------------------------------------}
  207.  
  208. Procedure Sector_Statistics(Bypass: Integer);
  209. {produce statistics for an entire sector}
  210. Begin;
  211.    Make_Mini_Map;
  212.    Solar_System_Count := 0;
  213.    Binary_Star_Count := 0;
  214.    Oxygen_World_Count := 0;
  215.    Gas_Giant_Count := 0;
  216.    Vacuum_World_Count := 0;
  217.    Poison_World_Count := 0;
  218.    Asteroid_Belt_Count := 0;
  219.    Black_Hole_Count := 0;
  220.    Protostar_Count := 0;
  221.    Ring_World_Count := 0;
  222.    Second_Star_Count := 0;
  223.    Dust_Cloud_Count := 0;
  224.    ClrScr;
  225.    For Y_Coordinate := 0 to 9 Do
  226.       Begin;
  227.         For X_Coordinate := 0 to 9 Do
  228.         Begin;
  229.           WG_System := System_Details [Y_Coordinate, X_Coordinate];
  230.           Old_Systems;
  231.           if WG_System > '!' then Begin;
  232.               Security_Tag := Copy (WG_System,40,1);
  233.               If Security_Tag = '*' then writeln('   Restricted system at ',Y_Coordinate,X_Coordinate,Z_Coordinate);
  234.               Solar_System_Count := Solar_System_Count +1;
  235.               A := Copy (WG_System,4,1);
  236.               Case Char(Ord(A[1])) of
  237.               '*': begin;
  238.                      Binary_Star_Count := Binary_Star_Count +1;
  239.                      Writeln('   Close binary pair at ',Y_Coordinate,X_Coordinate,Z_Coordinate);
  240.                      Delete (Mini_Map [X_Coordinate],2*Y_Coordinate+2,1);
  241.                      Insert ('<',Mini_Map [X_Coordinate],2*Y_Coordinate+2);
  242.                    End;
  243.               '(': begin;
  244.                      Black_Hole_Count := Black_Hole_Count +1;
  245.                      Writeln('   Black hole at ',Y_Coordinate,X_Coordinate,Z_Coordinate);
  246.                      Delete (Mini_Map [X_Coordinate],2*Y_Coordinate+2,1);
  247.                      Insert ('{',Mini_Map [X_Coordinate],2*Y_Coordinate+2);
  248.                     End;
  249.                ')': begin;
  250.                       Protostar_Count := Protostar_Count +1;
  251.                       Writeln('   Proto-Star at ',Y_Coordinate,X_Coordinate,Z_Coordinate);
  252.                       Delete (Mini_Map [X_Coordinate],2*Y_Coordinate+2,1);
  253.                       Insert ('[',Mini_Map [X_Coordinate],2*Y_Coordinate+2);
  254.                     End;
  255.               End;
  256.               For  I := 1 to 17 Do
  257.               Begin;
  258.                 A := Copy (WG_System,(I*2)+4,1);
  259.                 If A <> ' ' then
  260.                 Case Char(Ord(A[1])) of
  261.                  '0': Asteroid_Belt_Count := Asteroid_Belt_Count +1;
  262.                  '1': begin;
  263.                        Oxygen_World_Count := Oxygen_World_Count +1;
  264.                        Delete (Mini_Map [X_Coordinate],2*Y_Coordinate+1,1);
  265.                        Insert ('#',Mini_Map [X_Coordinate],2*Y_Coordinate+1);
  266.                       End;
  267.                  '2': Poison_World_Count := Poison_World_Count +1;
  268.             '3'..'5': Vacuum_World_Count := Vacuum_World_Count +1;
  269.             '6'..'9': Gas_Giant_Count := Gas_Giant_Count +1;
  270.             'A'..'L': Second_Star_Count := Second_Star_Count + 1;
  271.                  'S': Dust_Cloud_Count := Dust_Cloud_Count + 1;
  272.             'Q'..'R': Begin;
  273.                         Ring_World_Count := Ring_World_Count + 1;
  274.                         If A = 'R' then Writeln('   Oxygen Ring world at ',Y_Coordinate,X_Coordinate,Z_Coordinate);
  275.                         If A = 'Q' then Writeln('   Toxic Ring world at ',Y_Coordinate,X_Coordinate,Z_Coordinate);
  276.                       End;
  277.                 End;
  278.               End;
  279.             End;
  280.          end;
  281.      End;
  282.    Writeln('This sector contains ',Solar_System_Count,' systems,');
  283.    If Second_Star_Count >0 then Writeln(Second_Star_Count,' systems include secondary stars');
  284.    Writeln(Oxygen_World_Count,' planets have oxygen atmospheres.');
  285.    Writeln(Vacuum_World_Count,' planets have no atmosphere.');
  286.    Writeln(Poison_World_Count,' planets have toxic atmospheres.');
  287.    Writeln(Gas_Giant_Count,' planets are gas giants.');
  288.    Writeln('There are ',Asteroid_Belt_Count,' asteroid belts');
  289.    If Dust_Cloud_Count >0 then Writeln('and ',Dust_Cloud_Count,' dust clouds.');
  290.    Writeln;
  291.    Show_Mini_Map;
  292.    If Bypass = 0 then Beep_Wait else Exit;
  293.    ClrScr;
  294. End;
  295.  
  296. Procedure System_Statistics(Bypass : Integer);
  297. Begin;
  298.   If Bypass = 0 then Choose_System(3) else Menu_Status := 3;
  299.   If Menu_Status = 3 then Planet_Details(1);
  300. end;
  301.  
  302. Procedure Full_Sector_Statistics;
  303. Begin;
  304.   Writeln('This procedure takes some time; for best speed'#10#13'use a printer with a large buffer, or');
  305.   Writeln('a spooler program.');
  306.   Writeln('You can stop the run by pressing any key;'#10#13'it will stop at the end of the next system'#10#13);
  307.   Writeln('Press "X" to cancel, or any other key to continue');
  308.   Beep_Wait;
  309.   If Dummy = 'X' then exit;
  310.   Sector_Statistics(1);
  311.   Screen_Dump;
  312.   Colour_Selection;
  313.   GraphWindow(0,0,319,199);
  314.   Draw_Grid;
  315.   For Y_Coordinate := 0 to 9 Do
  316.     For X_Coordinate := 0 to 9 Do
  317.         Begin;
  318.           WG_System := System_Details [Y_Coordinate, X_Coordinate];
  319.           if WG_System > '!' then begin;
  320.               GraphWindow(0,0,319,199);
  321.               System_Location_XYZ;
  322.               System_Statistics(1);
  323.           end;
  324.           Writesafe(1,Chr(12));
  325.           If Keypressed then exit;
  326.         End;
  327. End;
  328.  
  329. Procedure Show_Sector_Ascii;
  330. Begin;
  331.   Writeln(#10#13'Data is shown in order: coordinates'#10#13'then a symbol for the star or binary:');
  332.   Writeln('   Star type, or "*" & a character = binary, "(" = black hole, ")" = protostar');
  333.   writeln('then symbols for up to 17 orbiting planets, stars, etc.');
  334.   Writeln('   1 = Earth-like'#10#13'   2 = Poison atmosphere'#10#13'   3 = Airless, cratered');
  335.   Writeln('   4 = Airless, mountainous'#10#13'   5 = Airless, icy'#10#13' 6-9 = Gas giants');
  336.   Writeln('   Q = Ringworld (poison atmosphere)'#10#13'   R = Ringworld (oxygen atmosphere)'#10#13'   S = Dust cloud');
  337.   Writeln('   or star type symbol for an orbiting star'#10#13'Final "*" for restricted system'#10#13);
  338.   Beep_Wait;
  339.   Writeln('system ..........Orbit number........... Restricted');
  340.   Writeln('      **1 2 3 4 5 6 7 8 9 A B C D E F G H * Systems');
  341.   For Y_Coordinate := 0 to 9 Do
  342.     For X_Coordinate := 0 to 9 Do begin;
  343.     WG_System := System_Details [Y_Coordinate, X_Coordinate];
  344.       if WG_System > '!' then begin;
  345.          writeln('   ',wg_System);
  346.          delay(500);
  347.       end;
  348.   end;
  349. end;
  350.  
  351. Procedure Distances;
  352. Var
  353.   Light_Years : Real;
  354.   ZZ : Integer;
  355. Begin;
  356.   Choose_System(5);
  357.   Old_Systems;
  358.   XX := X_Coordinate;
  359.   YY := Y_Coordinate;
  360.   ZZ := Z_Coordinate;
  361.   Top_Of_Menu_Screens;
  362.   WG_Textcolor(Red);
  363.   GotoXY(13,4);
  364.   Write('Distance [light years] from chosen system ');
  365.   WG_Textcolor(Lightblue);
  366.   Writeln(YY,XX,ZZ);
  367.   WG_Textcolor(red);
  368.   Writeln('       0     1     2     3     4     5     6     7     8     9');
  369.   For N := 0 to 9 do begin;
  370.     GotoXY(2,6+(N*2));
  371.     Write(n);
  372.   end;
  373.   For Y_Coordinate := 0 to 9 Do
  374.     For X_Coordinate := 0 to 9 Do
  375.         Begin;
  376.           WG_System := System_Details [Y_Coordinate, X_Coordinate];
  377.           if WG_System > '!' then begin;
  378.               Old_Systems;
  379.               Light_Years := Sqrt(Sqr(Y_Coordinate - YY)+Sqr(X_Coordinate - XX));
  380.               Light_Years := Sqrt(Sqr(Light_Years) + Sqr (Z_Coordinate - ZZ));
  381.               GotoXY(6+(Y_Coordinate*6),6+(X_coordinate*2));
  382.               If (XX = X_Coordinate) and (YY = Y_Coordinate) then
  383.                 WG_Textcolor(LightBlue)
  384.                   else WG_Textcolor(LightGreen);
  385.               Write(Light_Years:4:1);
  386.           end;
  387.         end;
  388.   Beep_Wait;
  389. End;
  390.  
  391.  
  392.  
  393. Procedure Statistics;
  394. Begin;
  395. Repeat;
  396.   Top_Of_Menu_Screens;
  397.   If Systems_In_Memory = 0 then
  398.       Begin;
  399.         No_Sector_Error;
  400.         Exit;
  401.       End;
  402.   Writeln ('Sector Statistics section'#10#13'Choose Options;'#10#13'[B] BRIEF analysis of sector data');
  403.   Writeln ('[P] PRINT details of one system'#10#13'[A] Print details of ALL systems');
  404.   Writeln ('[D] DISTANCES between systems');
  405.   Writeln('[V] VIEW sector record (ASCII)'#10#10#13'[X] eXit to main menu'#10#10#13'[H] HELP');
  406.   Statistics_Status := 3;
  407.   Beep_Wait;
  408.     Command := Dummy;
  409.     Case command of
  410.     'B' : Sector_Statistics(0);
  411.     'P' : System_Statistics(0);
  412.     'A' : Full_Sector_Statistics;
  413.     'V' : Show_Sector_ASCII;
  414.     'H' : Help('DATA',' BPAVXD');
  415.     'D' : Distances;
  416.     end;
  417.   Until Command = 'X';
  418.   Statistics_Status := -1;
  419. end;
  420.